perm filename MSS.OLD[NEW,LCS]3 blob
sn#327784 filedate 1978-01-07 generic text, type T, neo UTF8
C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
DIMENSION LST(13),DP(0/7),LX(14),LY(6)
COMMON /DL/X22,SAVER,NAME,EXT /RRJJ/RJJ2,RJJ(20) /FONT/JFONT
1 /RINP/R(10,80),RPOS(2,50),RI(200) /RMOD/RMODE2,RSET4,IBEAM,
1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
COMMON /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
COMMON /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
1 /POSI/STFF(0/7),JJ2,POS
COMMON /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
1 /ALF/INP(72),ML /UPDWN/ RL,UD
COMMON /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(300)
CC COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
COMMON /XRN/RN(2500) /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(300)
CC COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
1,(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(IT,LY(6))
1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1))
1,(R9,RJQ(7)),(IR,LX(11)),(IU,LX(13)),(RX3,RJQ(20)),(IA,LX(1))
1,(ST2,ST(2)),(IBL,LY(1)),(R13,RJQ(11)),(J13,JQ(11))
1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
1,(LX(2),ICC),(LX(5),IG),(LX(3),ID),(LX(14),IXX),(IPOS,POS)
DATA STFF/-469.,-346.,-223.,-100.,23.,146.,269.,350./
1 ,LST/'NOTE','REST','CLEF','LINE','SLUR',
1 'BEAM','TRILL','STAFF','MISC','NUMB','WORD','KSIG','METER'/
1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
1 'S','U','X'/,LIMIT/2500/
1,LY/' ','A','B','D','E','T'/, DIS/1.0/, RHT/1.0/
C LIMIT IS MAIN ARRAY LENGTH (2500)
C 300 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
CALL SEGFIX
C FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
CC TYPE 9999
CC9999 FORMAT(' ****** NEW VERSION OF MS (3/77) ******'/
CC 1' IF INSURMOUNTABLE BUGS ARE ENCOUNTERED TRY'/
CC 1' MS.OLD AND MP.OLD (BOTH ON OLD,LCS) ')
LCEN=0
MCEN=0
CP TOP2=-999
C IF -1, THEN TRUE OUTLINES OF FONTS ARE DISPLAYED.
I1=0
CP DIS=1.
CP RHT=1.
C FOR 'FILLER' ON CRT.
2 CALL DPYSET(1,ST,4000)
CALL HYDPOG(2)
CALL HYDPOG(1)
CALL TYPLOC(450,0)
CALL DPYBRT(5)
DO 299 K=1,I
CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
299 RN(K)=0
JFONT=0
IX=0
RSET4=999
QUICK=0
UD=1
RL=1
FSCN=IL
RPOS(1,1)=0
CP PLOTIT=0
RSZ=.845
CP TOP=-999
CP BOT=999
X22=0
JCEN=0
KCEN=0
PLT=0
PWDS(1)=1
EDX=-1
RN(2)=0
C FOR RESTART. AVOIDS STAFF CODE NUM.
SAVER=7
DO 1402 K=0,7
1402 RSTFAC(K)=1.
REDIT=999.
M=1
ITEM=0
ZERO=-1
WDS(1)=4
C DATA IN DPY ARRAY STARTS AT WD.4!
I=1
1100 SCORE=-1
58 IGO=-1
IF(I1.NE.'R')GO TO 5505
CF CALL FORMAT(NAME)
I1=-1
CALL NAMEXT(INP,NAME,EXT)
IF(NAME.NE.IBL)GO TO 1221
C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
GO TO 5505
11 CALL NOTWRT
CP57 IF(PLT)GO TO 6120
57 IF(M.GT.I)GO TO 571
IF(IGO)CALL DPYOUT(1)
571 ITEM=ITEM+1
IF(ITEM.LT.300)GO TO 17
TYPE 170,ITEM
I=PWDS(300)
ITEM=299
ST2=WDS(300)
CALL DPYOUT(1)
GO TO 1100
170 FORMAT(2(' **** TOO MANY ITEMS ',I3,'/299'/))
17 IF(IGO.GT.0)GO TO 20000
K=ST2
IF(X22.EQ.0)GO TO 20000
CALL BOX(IBOX,RBOX)
ST2=K
20000 WDS(ITEM+1)=ST2
IF(EDX.EQ.-1)GO TO 1571
IF(M.LT.I)GO TO 6120
CP1571 IF(PLOTIT.EQ.-2)GO TO 2311
C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
1571 PWDS(ITEM+1)=I
PLT=0
IF(IGO.NE.0)GO TO 55
CALL DPYOUT(1)
IF(SCORE.EQ.0)GO TO 9532
C GO GET MORE FROM SCX.
IGO=-1
55 IF(SCORE.EQ.0)GO TO 653
5505 SVST=ST2
C CATCHES TYPO WITH 'C'
K=ITEM+1
IF(X22.EQ.0)GO TO 5503
C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
IF(QUICK)5911,210,10
C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS
210 K=X22
L=RN(MEDIT+1)
IF(L.EQ.13)L=11
CC IF(L.EQ.10)L=9
CC IF(L.GE.16.AND.L.LE.18)L=L-5
IF(L.GE.11)L=L-1
IF(L.GE.15)L=L-4
CC IF(L.EQ.20)L=12
TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
IF(YED.LT.2)GO TO 59
CP IF(YED.LT.2)GO TO 5504
C YED IS SET AT 426
DO 5501 L=4,YED+2
5501 TYPE 4271,L,RN(MEDIT+L)
GO TO 59
5919 FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
591 QUICK=-1
TYPE 5919
5911 CALL FSCAN
C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
GO TO 1591
GO TO 2591
GO TO 3591
GO TO 4591
GO TO 5913
GO TO 6591
GO TO 7591
GO TO 5912
I1=0
5591 QUICK=0
GO TO 5917
5503 CALL HYDPOG(3)
C TO DELETE VERTICAL LINE (55)
KED=0
QUICK=0
C RESET PARAM TYPE-OUT
59 TYPE 56,NAME,K,I,SVST
10 JAB=JA
SCORE=-1
ACCEPT 89,INP
5917 DO 1313 L=1,14
1313 IF(I1.EQ.LX(L))GO TO 2313
GO TO 310
C 'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF;
2313 IF(X22.NE.0)GO TO(884,883,883,5313,87,87,87,883,87,87,883
1,15,883,883),L
CP GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
GO TO(13,7555,14,5313,120,87,7555,883,7555,87,883,15,883
1,59),L
C A C D E G I J L M P R S U(X
C HERE A=ALTER A GROUP, DE=DELETE A GROUP
C 'DP'=DISPLAY OR HIDE WHICH STAVES. D=DOWN N
14 IF(I2-IE)883,13,884
13 IF(I2.EQ.ID)GO TO 884
C 'AD' = ADJUST STEMS TO MEET BEAMS (CODE# 19)
IGO=1
CALL GRED
JFONT=0
IF(JA.EQ.98)GO TO 5533
KNT=0
SCORE=0
GO TO 653
1591 I1=IL
9591 FSCN=I1
GO TO 5917
2591 I1=IR
GO TO 9591
3591 I1=IU
GO TO 9591
4591 I1=ID
GO TO 9591
7591 I1=IXX
GO TO 5591
5912 I1=ICC
GO TO 5591
5913 I1=FSCN
IF(FSCN.EQ.IL)GO TO 5914
IF(FSCN.EQ.IR)GO TO 5914
C NEXT FOR UP-DOWN
UD=UD/2
GO TO 5917
5914 RL=RL/2
GO TO 5917
6591 I1=FSCN
IF(I1.EQ.IL)GO TO 5916
IF(I1.EQ.IR)GO TO 5916
UD=UD*2
GO TO 5917
5916 RL=RL*2
GO TO 5917
C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
15 DO 3313 L=1,6
3313 IF(I2.EQ.LY(L))GO TO(312,3121,3121,3121,312,884),L
C BL A B D E T
IF(I2.EQ.ICC)GO TO 884
IF(I2.EQ.IP)GO TO 87
IF(I2.EQ.'H')JFONT=1
IF(I3.EQ.IXX)JFONT=0
IF(I3.EQ.IP)JFONT=-1
IF(I3.EQ.'O')JFONT=-2
IF(I3.EQ.II)JFONT=-3
C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
C 'SHP' = SHOW ONLY AS 'PRIMATIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
IF(I2.NE.IM)GO TO 5505
C ONLY FOR ST, SA, SB, SM, RS, S
3121 IF(X22.NE.0)GO TO 5505
SAVER=7
CALL SAVIT
GO TO 5505
312 JA=55
R2=RN(MEDIT+3)
C POSITION OF ITEM LOOKED AT.
R3=55.
GO TO 6531
C ABOVE FOR 'S'ET ALIGNMENT
C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
CF5313 IF(I2.NE.IXX)GO TO 6313
CF JA=EXT
C TYPE 'EXT NNN' TO PUT .NNN AS EXTENSION ON OUTPUT FILES.(.DMD=DEFAULT)
CF REREAD 1885,K,EXT
CF IF(EXT.NE.IBL)GO TO 5505
CF EXT=JA
C TYPE 'EXT' ONLY TO SEE WHAT IS CURRENT EXT.
CF TYPE 1885,IBL,EXT
CF GO TO 5505
CF1885 FORMAT(A4,A3)
CF6313 K=-1
5313 K=-1
DO 882 JA=3,10
882 IF(INP(JA).NE.IBL)GO TO 884
GO TO 883
885 FORMAT(A2,21F)
884 REREAD 885,K,R2,RJQ
JA=55
IF(I2.NE.ICC)GO TO 101
CALL SCL
GO TO 5505
101 IF(I2.NE.ID)GO TO 988
IF(I1.EQ.IA)JA=19
C 'AD'just stems to beams.
988 IF(I2.EQ.IT)JA=44
IF(I2.EQ.'N')GO TO 188
IF(I2.NE.IP)GO TO 6531
IF(R2.GT.7)GO TO 1886
C GO BACK AND RESET ALL IF STF NUM >7
K=R2
JA=0
C USE '8' FOR STAFF 0.
888 IF(K.EQ.8)K=0
DP(K)=-DP(K)
JA=JA+1
K=RJQ(JA)
IF(K.EQ.0)GO TO 55
C JUMP OUT IF RJQ(JA)=0 OR 99
IF(K.EQ.99)GO TO 85
C*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
GO TO 888
C TO GET BACK ALL LINES TYPE 6+
311 JA=0
IGO=1
ML=0
IF(I2.NE.IL)GO TO 884
1886 DO 2886 K=0,7
2886 DP(K)=1
GO TO 85
CP IF(I1.NE.IP)GO TO 8851
C PL RESETS 'DP'
C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
CP2311 CALL PLTCMD
CP IF(PLOTIT.EQ.0)GO TO 3005
CP I1=IP
CP PLOTIT=-1
CP GO TO 6531
C 'PL' GOES TO 'PLOT COMMAND' ROUTINE
881 IF(I1.GT.0)GO TO 87
C JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
C NEXT FOR READ, RS, DEL, L,R,U,D
883 IF(I1.EQ.IR)GO TO 8835
IF(IX.EQ.I)GO TO 8834
C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
IF(I2.NE.IE)GO TO 8831
GO TO 5505
8835 IF(I2.EQ.IS)GO TO 2
C TYPE 'RS' TO RESTART.
IF(I2.NE.IE)GO TO 8831
C 'READ' IS SAME AS 144
JA=144
GO TO 88
8834 IF(I1.EQ.ICC)GO TO 72
8831 IF(JA.NE.16)GO TO 8832
IF(X22.EQ.0)GO TO 5505
C CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
8832 CALL EDIT(JJA)
IF(JA.NE.99)GO TO 6531
CALL DELETE
C DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
GO TO 425
89 FORMAT(72A1)
C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
310 IF(I1.EQ.'N')GO TO 410
IF(X22.EQ.0)GO TO 87
IF(I1.EQ.'Q')GO TO 591
GO TO 87
410 IF(QUICK.NE.0)GO TO 510
C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
QUICK=1
C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
IF(X22.NE.0)GO TO 87
510 I1=II
C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
87 REREAD 1,JA,R2,RJQ
IF(I1.NE.II)GO TO 610
IF(I2.EQ.'N')GO TO 884
C 'IN n,n,n,' MUST BE READ AGAIN AT 884 TO GET n'S CORRECTLY.
JA=22
GO TO 6531
610 IF(K)JA=55
C ED 47 -1 = 55 47 -1, ETC.
IF(JA.EQ.101)GO TO 101
CC IF(JA.EQ.44)GO TO 221
CC IF(JA.EQ.14)GO TO 88
C IS THERE A BUG CONCERNING SAVIT AND 'SCORE'????
CC IF(JA.EQ.144)GO TO 88
CC IF(JA.EQ.444)GO TO 440
IF(I1.NE.'N')GO TO 710
IF(R2.NE.0)GO TO 510
C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
GO TO 10
710 IF(I1.EQ.'Z')GO TO 24
C 'Z' = ZOOM (OLD CODE# 24)
IF(I2.NE.IP)GO TO 441
RSET4=R3
C SPn SETS "SETUP" STAFF NUMBER
GO TO 5505
C 'SP' IS SAME AS 444
441 IF(I1.EQ.IP)GO TO 33
C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
IF(I1.NE.IT)GO TO 110
IF(X22.EQ.0)GO TO 288
QUICK=0
C TYPE 'T' TO RESET PARAM TYPE-OUT
IF(R2.EQ.0)GO TO 5505
GO TO 510
110 IF(JA.GT.0)SAVER=SAVER-1
IF(X22.NE.0)GO TO 6531
IF(SAVER)CALL SAVIT
C SAVES EVERY 7TH TIME AROUND
IF(JA.EQ.0)GO TO 5505
C CATCHES ZEROS AND LOWER CASE LETTERS.
GO TO 6531
C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
288 JA=16
M=I
J2=R2
CALL WORDS
SAVER=SAVER-1
GO TO 8852
CC188 R3=0
CC88 SET4=R3
C *** THIS FEATURE CHNGD. 6/75***SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
188 IF(X22.NE.0)GO TO 5505
JA=14
RMODE2=R3
C TYPE 'IN STF# MODE' ETC. -- SAME AS 14 STF#.
88 SCORE=0
IF(JA.NE.14)GO TO 889
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
SAVER=-1
RSTF=R2
IF(R3)R3=0
DO 1889 K=1,ITEM
J=PWDS(K)
IF(RN(J+1).NE.8)GO TO 1889
IF(RN(J+2).EQ.R2)GO TO 890
1889 CONTINUE
C DIDN'T FIND THIS STAFF
M=2000
IGO=0
JA=8
R3=0
GO TO 6531
890 JA=14
ITCHK=ITEM
ICHK=I
IDPY=ST2
C ALL THIS FOR BACKUPS
889 SPD=ST2
JIT=ITEM
ISC=I
REND=0
C RETAINS ORIGINS OF SCORE SQUENCE
9532 IF(REND.EQ.2)GO TO 889
C FOR READIN CONTINUATION.
M=ISC
9533 IF(JA.EQ.8)GO TO 890
IF(REND)GO TO 9535
C REND=0 GO, -1=NORMAL END, 1=ABORTED.
CALL SCMSS
IF(REND.EQ.1)GO TO 9535
IF(REND.NE.99)GO TO 9534
I=ICHK
ITEM=ITCHK
ST2=IDPY
CALL ACCPOG(1)
CALL DPYOUT(1)
GO TO 9535
9534 ITEM=JIT
J=M
9536 ITEM=ITEM+1
PWDS(ITEM)=J
J=J+RN(J)+3
IF(J.LT.I)GO TO 9536
IF(IBEAM)GO TO 9537
R13=0
R2=RSTF
JA=19
J3=0
CALL HOMER
9537 ITEM=JIT
ST2=SPD
GO TO 8852
9535 SCORE=-1
CALL SHRINK(JIT)
C GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
IGO=-1
JA=16
C FOR TRAP AT 'EDIT'
GO TO 5505
CC553 IF(SCORE)GO TO 6531
653 KNT=KNT+1
C NUM OF ITEMS IN LIST
R11=0
R10=0
R9=0
JA=R(1,KNT)
R2=R(2,KNT)
IF(JA.NE.0)GO TO 550
C =0 MEANS NO MORE ITEMS.
CALL DPYOUT(1)
GO TO 1100
5533 X22=0
IGO=-1
CALL DPYNEW
GO TO 55
550 DO 7531 K=1,6
7531 RJQ(K)=R(K+2,KNT)
6531 M=1
EDX=-1
IF(JA.EQ.222)GO TO 72
IF(JA.EQ.2222)GO TO 73
DO 5532 K=1,20
5532 JQ(K)=RJQ(K)
CC J2=R2 DOES THIS AT 60
CP7542 IF(I1.EQ.IP)GO TO 590
C X22= ITEM# WHEN EDITING OR DELETING.
IF(X22.NE.0)GO TO 5511
IF(JA.GT.0)GO TO 155
IF(R2.EQ.0)GO TO 5505
C FOR UP, DOWN, LEFT, RIGHT
RJJ2=J2
GO TO 6221
C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
155 IF(JA.EQ.22)GO TO 42
IF(JA.EQ.44)GO TO 44
C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
IF(JA.EQ.55)GO TO 554
IF(JA.NE.19)GO TO 60
271 CALL HOMER
GO TO 8853
33 IF(X22.EQ.0)GO TO 6333
C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
J2=R2
TYPE 331,J2,RJJ(J2-2)
C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
GO TO 5505
331 FORMAT(I,F15.5)
24 IF(X22.NE.0)GO TO 5505
JA=24
C CAN'T DO ZOOM WHILE IN EDIT MODE
IGO=0
23 IF(R2.LT.100)GO TO 2410
R3=AMOD(R2,100.)
R2=(R2-R3)/100.
R4=R2*6-R2
C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
2410 IF(R2.NE.0)GO TO 241
IGO=-1
243 R2=1.
C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
241 RSZ=.845*R2
JCEN=(R3*10-500)*RSZ
KCEN=(R4*10-480)*RSZ
C NEXT TO RECONSTITUTE SPACING SCALE.
IF(R2.GT.1)GO TO 240
JCEN=0
KCEN=0
IF(R2.EQ.1)GO TO 3312
240 R2=(R4-100.)/100.
C%%%%%%%%%%%%%
IF(R2.LT.0)R2=0
C WE DON'T WORRY IF IT'S TOO HIGH (YET).
3312 R4=0
R2=R2+1
CALL SCL
R2=0
R3=0
R4=0
LCEN=0
MCEN=0
C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
JFONT=0
85 M=1
I=PWDS(ITEM+1)
ITEM=0
8552 ST2=3
8852 PLT=1
EDX=0
CALL ACCPOG(1)
IF(JA.EQ.0)GO TO 6120
IF(JA.NE.24)IGO=0
GO TO 6120
6333 CALL LISTP(LST)
GO TO 5505
172 CALL JUGGLE
CALL CLRCUR
CALL DPYNEW
IF(JA.EQ.22)GO TO 424
C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
IF(ZERO)GO TO 55
X22=ZERO
ZERO=-1
IF(JA.EQ.55)GO TO 554
IF(JA.EQ.44)GO TO 44
IF(KED.NE.0)GO TO 244
GO TO 425
C 55,POS -- SETS UP ALIGNMENT
554 CALL BOX(-1,R2)
IF(J4.EQ.0)KED=-1
RITEM=R4
C FOR 'ED POS., STF., CODE#' (STF > 7 = ALL STAVES)
IF(J3.GT.7)KED=-2
RLINE=R2
R2=R3
GO TO 45
C '22,0' EDITS LAST ITEM ENTERED
42 REDIT=999.0
IF(R2.NE.0)GO TO 242
X22=ITEM
GO TO 429
44 KED=1
RITEM=R3
C 'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
IF(R2.GT.7)KED=2
45 REDIT=R2
C THE STAFF #
JED=1
244 X=ITEM
IF(JED.GT.X)GO TO 444
DO 144 K=JED,X
L=PWDS(K)
IF(KED.EQ.-2)GO TO 654
C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
IF(KED.EQ.2)GO TO 656
IF(RN(L+2).NE.REDIT)GO TO 144
IF(KED)GO TO 654
IF(RITEM.EQ.0)GO TO 655
656 IF(RITEM.NE.RN(L+1))GO TO 144
655 IF(JA.NE.55)GO TO 344
654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
144 CONTINUE
444 REDIT=999.
C NO MORE ON LINE
R2=0
C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
GO TO 73
344 JED=K+1
C FOR NEXT TIME AROUND
X22=K
GO TO 429
C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
91 CALL ACCPOG(1)
IF(I.EQ.IX)ITEM=ITEM-1
GO TO 142
242 IF(X22.GT.0)GO TO 5511
142 IF(R2.NE.0)GO TO 424
IF(REDIT.EQ.999)GO TO 1554
IF(JA.GE.0)GO TO 244
1554 X22=X22+1
IF(JA)X22=X22-1+JA
IF(X22.LT.1)X22=1
GO TO 425
427 FORMAT(1XA5/,2F6.0,F10.2,$)
4271 FORMAT('+ (',I2,')',F7.2,$)
C FOR EDITING
5511 IF(JA.EQ.55)GO TO 420
220 IF(JA.NE.22)GO TO 720
C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
KED=0
JED=0
GO TO 72
720 IF(JA.EQ.44)GO TO 420
C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
IF(JA.GT.100)GO TO 4221
IF(JA.GT.13)GO TO 5505
C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
4221 IF(X22.EQ.0)GO TO 5517
IF(R2.NE.0)GO TO 5517
C BACKS UP WHEN IN EDIT MODE.
IF(JA.GT.0)GO TO 5518
IF(I.EQ.IX)GO TO 91
ZERO=X22+1
C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
72 IF(X22.EQ.0)GO TO 55
IF(KED.EQ.0)REDIT=999.
320 IF(I.NE.IX)GO TO 172
ITEM=ITEM-1
C TO DELETE AN ITEM
73 X22=0
CALL CLRCUR
CALL DPYNEW
IF(REDIT.EQ.999.)GO TO 428
IF(JA.EQ.55)GO TO 554
IF(JA.EQ.44)GO TO 44
428 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
424 X22=R2
425 IF(X22.GT.ITEM)GO TO 73
C LEAVES EDIT MODE.
429 IX=I
MEDIT=PWDS(X22)
J=2
426 Y=RN(MEDIT)+J
CALL LOOP(0,Y,1,I,MEDIT,RN)
JJA=RN(I+1)
YED=Y-2
L=I+2
DO 422 K=1,11
IF(K.GT.YED)GO TO 423
RJJ(K)=RN(L+K)
GO TO 422
423 RJJ(K)=0
422 CONTINUE
RJJ2=RN(L)
IF(IGO.GT.0)GO TO 4231
C NO BOX WHEN IN GROUP EDIT ROUTINE
IBOX=I
RBOX=RJJ2
CALL BOX(IBOX,RBOX)
4231 ITEM=ITEM+1
ST2=WDS(ITEM)
GO TO 55
5517 IF(JA.EQ.0)GO TO 6221
5518 X=100-JA
IF(X)JA=JA/100
IF(JA.LE.2)GO TO 7221
IF(JA.LE.13)GO TO 324
JA=JA/10
C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
X=R2-2.
RJJ(JA-2)=RJJ(X)
GO TO 6222
324 I1=JA-2
IF(X)GO TO 224
RJJ(I1)=R2
GO TO 6222
224 RJJ(I1)=RJJ(I1)+R2
GO TO 6222
7555 CALL MOVER
IF(R2.EQ.99)GO TO 59
C 99=BACKUP OUT OF MOVER ETC.
IGO=0
JFONT=0
C SO IT WON'T DO ALL FONT LOOKUPS.
8853 IF(JJ2)GO TO 5505
M=PWDS(JJ2)
I=PWDS(ITEM+1)
ITEM=JJ2-1
ST2=WDS(JJ2)
C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
GO TO 8852
420 REDIT=0
211 IF(R2.NE.0)GO TO 320
IF(KED.GE.0)RLINE=RJ3
RJ3=RLINE
GO TO 6222
C FOR '55' ALIGNING
7221 IF(X)GO TO 4223
CALL PARCH(JA,JJA,R2)
GO TO 6222
4223 RJJ2=R2+RJJ2
C ARRAYS NEED 2O LOCATIONS HERE.
C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
6222 DO 1222 K=1,20,2
L=JQ(K)
IF(L.EQ.0)GO TO 6221
C '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
RD=RJQ(K+1)
X=L
IF(L.LT.100)GO TO 223
IF(L.LT.2000)GO TO 5223
X=L/1000
L=JQ(K+1)-2
RD=RJJ(L)
GO TO 2223
5223 X=L/100
IF(X.EQ.2)GO TO 1223
RD=RJJ(X-2)+RD
GO TO 2223
1223 RD=RJJ2+RD
223 IF(X.LE.2)GO TO 3223
2223 RJJ(X-2)=RD
GO TO 1222
3223 CALL PARCH(X,JJA,RD)
C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
1222 CONTINUE
C*** LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
6221 DO 5514 K=1,11
R2=RJJ(K)
RJQ(K)=R2
5514 JQ(K)=R2
R2=RJJ2
JA=JJA
ITEM=ITEM-1
IF(ITEM)ITEM=0
ST2=WDS(ITEM+1)
I=PWDS(ITEM+1)
CALL DPYNEW
60 J2=R2
RSTJ2=RSTFAC(J2)
CL RD=0
IF(JA.NE.2)GO TO 163
CJ IF(R9.EQ.0)GO TO 163
IF(R8.EQ.0)GO TO 163
IF(R8.EQ.-1)GO TO 163
IF(R8.EQ.-4)GO TO 163
C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
K=ITEM
C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
IF(X22.NE.0)K=X22-1
RD=1.75*RSTJ2
L=PWDS(K+2)
IF(RN(L+1).NE.4)GO TO 164
C GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
IF(RN(L+2).NE.R2)GO TO 164
RB=RN(L+3)
L=PWDS(K)
C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
IF(RN(L+1).NE.4)GO TO 164
IF(RN(L+2).NE.R2)GO TO 164
C JUMP IF NOT ON SAME STAFF
RA=RN(L+3)
R3=RA+(RB-RA)/2-1.75*RSTJ2
164 IF(PLT.EQ.0)GO TO 160
RN(PWDS(K+1)+3)=R3
C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
GO TO 5541
163 IF(JA.EQ.16)GO TO 63
IF(PLT.NE.0)GO TO 5541
IF(JA.NE.8)GO TO 70
IF(R9.NE.1)GO TO 160
L=7
C RJQ(7) IS R9
71 RA=RN(MEDIT+L+2)
TYPE 427,RA
721 FORMAT(' TYPE INST. NAME '$)
TYPE 721
ACCEPT FA5,RD
RJQ(L)=RD
IF(RD.NE.' ')GO TO 160
IF(RN(MEDIT).LT.L)RA=0
C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
RJQ(L)=RA
C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
GO TO 160
CF371 FORMAT(A5,A1,A3)
70 IF(JA.NE.11)GO TO 160
C ↑↑↑↑ WAS - TO 63
IF(J10.NE.1)GO TO 160
L=8
C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
GO TO 71
CC LASTNM=NJR
CC62 IF(NJR.EQ.0)NJR=LASTNM
C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
63 RD=R5
IF(RD.GE.100)RD=RD-100
C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
IF(J10.EQ.0)GO TO 162
L=ITEM
IF(X22.NE.0)L=X22-1
IF(J10.EQ.1)GO TO 263
C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
IF(J10.NE.99)GO TO 863
X=PWDS(X22)+6
DO 563 L=X,X+2
RB=RN(L)
K=RB
C CHECKS TO SEE WHICH FORMAT
563 IF(K.NE.RB)GO TO 663
GO TO 57
663 DO 763 L=X,X+2
763 RN(L)=RN(L)*100.
GO TO 57
C NEXT FOR CENTERING TEXT. P10>1
863 RB=0
X=PWDS(L+1)
363 L=L+1
K=PWDS(L)
RB=RB+RN(K+9)
C ADD SPACE NEEDED
K=PWDS(L+1)
IF(RN(K+1).NE.16)GO TO 463
IF(RN(K).EQ.8)GO TO 363
C GO BACK IF MORE LETTERS TO COME
463 R3=R10-(RB-3.4)*RD*RSTJ2/2.
C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
R10=0
IF(RN(X).EQ.8)RN(X+10)=0
RN(X+3)=R3
C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
GO TO 162
263 K=PWDS(L)
R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
C AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
R4=RN(K+4)
R5=RN(K+5)
R2=RN(K+2)
J2=R2
L=PWDS(L+1)
DO 361 JJA=3,5
361 RN(L+JJA)=RJQ(JJA-2)
RN(L+2)=R2
CCC RN(PWDS(L+1)+3)=R3
C PUTS POS. BACK INTO RN ARRAY EVERY TIME.
C PUTS 13TH(+) LETTER IN RIGHT POS.
162 IF(PLT.NE.0)GO TO 5541
CX160 IF(EDX.NE.0)GO TO 162
CP IF(I1.EQ.IP)GO TO 5541
CX162 RJ3=R3
160 RJ3=R3
JJA=JA
IF(R8.NE.0)GO TO 161
IF(JA.EQ.1)R8=999.
C 999=0 FOR STEM EXTENSIONS.
CL161 CNT=1
CL DO 5543 K=1,9
C 10/6/73 ABOVE WAS ,11
CL RA=RJQ(K)
CL IF(RA.NE.0)CNT=K
CL5543 RJJ(K)=RA
C USES ONLY 10 PARAMETERS BEYOND JA, J2
161 CALL MSSLUP
CP2554 IF(PLT.NE.0)GO TO 5541
IF(JA.NE.6)GO TO 1261
IF(J13.EQ.0)GO TO 171
R2=X22
X22=0
R3=R13
J3=J13
R4=R11
C RESET HOMING RANGE (DEFAULT=3) WITH P11.
CALL CLRCUR
R13=0
C TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
JA=19
GO TO 271
171 CALL HOMER
CC IF(JA.NE.13)GO TO 1261
CC IF(J6.NE.0)R13=-1
1261 IF(R13.EQ.0)GO TO 261
RD=R11
CALL HOMER
R11=RD
C R11 GETS CHANGED IN 'HOMER'
IF(JA.EQ.10)R3=R3+RSTJ2
IF(JA.NE.9)GO TO 261
IF(J5.GT.3)GO TO 261
CALL NOZERO(R6)
R3=R3+RSTJ2+2.*RSTJ2*R6
C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
C P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
C **** FOR '0' EDITS ******
CL261 RN(I)=CNT
CL RN(I+1)=JA
CL I=I+2
CL RN(I)=R2
CL IF(RD.NE.0)RN(I)=RD
C TO SAVE NOTE NUMBS IN P2.
CL DO 4554 K=1,CNT
CL4554 RN(I+K)=RJQ(K)
CL3554 I=CNT+1+I
261 CALL LUP2
5541 IF(DP(J2))GO TO 57
C*** 3/74 NEW DP SYSTEM
C WHAT ABOUT EDITS?*******
POS=STFF(J2)
RX3=R3
C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
J3=ROFF(RHORZ(R3))
C LINE IS DIVIDED INTO 200 POINTS.
CALL CENTX
C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
R3=J3
IF(JA.LE.2)GO TO 11
551 GO TO(1,1,68,25,67, 625,116,125,11,69, 68,12),JA
GO TO (116,81,80),JA-15
C FOR 16,17,18 (WORDS, KSIG, METER)
IF(JA.EQ.99)GO TO 57
C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
IF(JA.NE.33.AND.JA.NE.44)GO TO 222
JA=JA/11
C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
GO TO 551
222 I=PWDS(ITEM+1)
GO TO 5505
C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
69 CALL MAKNUM(R5)
GO TO 57
68 CALL CLEFS
GO TO 57
67 CALL SLUR
GO TO 57
116 CALL ALPHA
GO TO 57
81 CALL KSIG
GO TO 57
80 CALL METER
GO TO 57
125 IF(R2.EQ.0)RMOV=R8
CALL STAFF
GO TO 57
625 CALL BMSTF
GO TO 57
C BEAMS, STAFF LINES ****
12 CALL CIRCLE
GO TO 57
25 CALL ITMSUB
C BAR LINES, ETC.
GO TO 57
C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
120 IF(I.EQ.1)GO TO 1220
IF(I2.NE.IM)GO TO 222
C 'GM'=GET MORE
1220 I1=-1
CALL NAMEXT(INP,NAME,EXT)
CC1220 CALL FORMAT(NAME)
C NOW TYPE 'G NAME' OR 'GM NAME'
IF(NAME.NE.IBL)GO TO 1221
1225 TYPE 21
CF ACCEPT 371,NAME
ACCEPT 89,INP
C GO PUT A1'S INTO A5, ETC.
CALL NAMEXT(INP,NAME,EXT)
IF(NAME.EQ.'99')GO TO 5505
IF(NAME.EQ.IBL)GO TO 2220
CF IF(J.NE.IBL)EXT=J
1221 IF(LOOKX(NAME,EXT).EQ.0)GO TO 1225
C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2220 JA=-1
C -1 IS FOR 8852+3
2200 J=ITEM+1
IF(NAME.NE.IBL)GO TO 2207
CALL GETEXT('TMP','DMD')
GO TO 2202
2207 CALL GETEXT(NAME,EXT)
2202 CALL EXTIN(RSTFAC,128)
CALL EXTIN(PWDS(J),JJ2)
CALL EXTIN(RN(I),IPOS)
IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
C (K) BUG IN FORTRAN UNFORMATTED READ-WRITE. SOMETIMES LAST ITEMS WRONG.
ITEM=ITEM+JJ2-2
IF(I2.EQ.IM)GO TO 2203
I=IPOS
IF(RSTF.EQ.0)GO TO 85
C (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
CALL EXTIN(ST,4302)
CC CALL EXTIN(ST,4250)
CALL DPYNEW
GO TO 5505
2203 M=I-1
DO 2204 K=J,J+JJ2-2
2204 PWDS(K)=PWDS(K)+M
GO TO 85
M=IX
C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
C RMOV HAS INCHES FROM P8 OF STAFF 0.
C R6=1 FOR NO MOVE AT END. R7=INCHES TO MOVE FOR NEW STAFF 0.
C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE. THEN
C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
C MOVES PLOTTER UP IF P5=0.
C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120 IF(M.GE.I)GO TO 7120
IF(IGO.EQ.0)GO TO 7121
C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
IF(M.EQ.PWDS(ITEM+1))GO TO 7121
K=ITEM+1
TYPE 7122,K
PWDS(K)=M
7121 CALL RUNTHR(M)
IF(EDX.LE.0)GO TO 60
GO TO 5505
7122 FORMAT(' FIXING ITEM ',I3)
7120 M=1
IF(PLT.EQ.1)EDX=-1
PLT=0
GO TO 5505
C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I,I6/)
1 FORMAT(I,24F)
21 FORMAT(' NAME.EXT? '$)
END